home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / AveryLabels.pdrx < prev    next >
Text File  |  1992-06-18  |  5KB  |  233 lines
  1. /*
  2. @N
  3.  
  4. This Genie will read one of several Avery Label databases contained in the PDraw/Data directory and allow the user to create a variety of labels.
  5. */
  6. cr  = '0a'x
  7. address command
  8. msg = PDSetup.rexx(2,0)
  9. units = getclip(pds_units)
  10. if msg ~= "1" then exit_msg(msg)
  11.  
  12. sourcedir = ReadINI.rexx("FNT", "s:pdraw.ini")
  13. if sourcedir = '' then
  14. do
  15.     directory = pdm_GetFileName("Please find Pdraw/Data..", "", "")
  16.     if directory = '' then exit_msg("Unable to find label databases..")
  17.  
  18.     sourcedir = splitfilename.rexx(directory)
  19. end
  20.  
  21. if right(sourcedir, 1) = ":" then sourcedir = sourcedir'Data/'
  22. else sourcedir = sourcedir'/Data/'
  23.  
  24. labels = ''
  25. counter = 0
  26.  
  27. address command
  28. list    = getdirlist.rexx(sourcedir, ".db")
  29. if list = '' then exit_msg("Unable to find label database. Please reinstall!")
  30.  
  31. selection = pdm_SelectFromList("Select Type of label..", 35, 5, 0, list)
  32. if selection = '' then exit_msg()
  33.  
  34. filename = sourcedir || selection".db"
  35.  
  36. if ~open(file, filename, "r") then exit_msg("An error has occured reading database")
  37.  
  38. call pdm_ShowStatus("Reading label database..")
  39.  
  40. line    = readln(file)
  41.  
  42. if pos('LASER', line) ~= 0 then
  43.     labeltype = laser
  44. else if pos('MATRIX', line) ~= 0 then
  45.     labeltype = matrix
  46. else
  47.     exit_msg("Invalid database file")
  48.  
  49. spos = Pos('PAGESIZE', line)
  50.  
  51. if spos ~= 0 then
  52. do
  53.     line = substr(line, spos + 8)
  54.     opageh    = word(line, 2)
  55.     opagev    = word(line, 1)
  56. end
  57. else
  58. do
  59.     opageh    = 0
  60.     opagev    = 0
  61. end
  62.  
  63.  
  64. lcounter = 0
  65.  
  66. do while ~eof(file)
  67.  
  68.     line = strip(readln(file))
  69.  
  70.     if line = '' | left(line, 2) = '\*' | left(line, 2) = '*/' then
  71.         iterate
  72.  
  73.     lcounter = lcounter + 1
  74.  
  75.     parse var line code ';' name ';' .
  76.  
  77.     code = strip(code)
  78.     name = strip(name)
  79.     text = code || copies(" ", max(1,12 - length(code))) || name
  80.  
  81.     lines.lcounter.0    = line
  82.     lines.lcounter.1    = text
  83.  
  84.     labels = labels||cr||text
  85.  
  86. end
  87.  
  88. labels = delstr(labels,1,1)
  89. label = pdm_SelectFromList("Select Label..", 40, 10, 0, labels)
  90. if label = '' then exit_msg()
  91.  
  92. do i = 0 to lcounter - 1
  93.  
  94.     cline = lines.i.1
  95.     if cline = label then leave
  96.  
  97. end
  98.  
  99. line = lines.i.0
  100.  
  101. group = 0
  102. if pdm_SelFirstObj() ~= 0 then
  103.     group = pdm_Inform(2,"Would you like to tile the current selection to create labels?", "No","Yes")
  104.  
  105. if labeltype = laser then
  106. do
  107.     sline = compress(line)
  108.     parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' rows ';' topmarg ';' sidemarg ';' hpitch ';' vpitch ';' .
  109.  
  110.     if ~exists("rexx:TileSelection.pdrx") then
  111.         exit_msg("Unable to locate Genie named: rexx:TileSelection.pdrx")
  112.  
  113.     npages = pdm_GetForm("How many pages will you need?", 8, "Pages:1")
  114.     if npages = '' then exit_msg()
  115.     if ~datatype(npages, n) then exit_msg("Invalid entry")
  116.  
  117.     newpage = pdm_CreatePage(pdm_CurrentPage() + 1,1,)
  118.     call pdm_GotoPage(newpage)
  119.  
  120.     if opagev ~= 0 then do
  121.         call pdm_SetPageSize(newpage, opagev, opageh)
  122.     end
  123.  
  124.     if group = 1 then
  125.     do
  126.         call ScaleToPage(lwid, lheight, pdm_CurrentPage())
  127.         call pdm_GroupObj()
  128.         call TileSelection.pdrx(sidemarg,topmarg,rows, cols, hpitch, vpitch)
  129.     end
  130.     else
  131.     do
  132.         obj = pdm_DrawRectangle(sidemarg, topmarg, sidemarg + lwid, topmarg + lheight)
  133.         call pdm_SelectObj(obj)
  134.         call TileSelection.pdrx(sidemarg, topmarg, rows, cols, hpitch, vpitch)
  135.     end
  136.  
  137.     message = "Done"
  138.  
  139. end
  140. else
  141. do
  142.     sline = compress(line)
  143.     parse var sline pnum ';' type ';' lheight ';' lwid  ';' cols ';' cwidth ';' hpitch ';' vpitch ';' .
  144.  
  145.     npages = pdm_GetForm("How many Pages of Dot Matrix Labels?", 18, "Number of labels:"1)
  146.     if npages = '' then exit_msg()
  147.  
  148.     if ~datatype(npages, n) then exit_msg("Invalid input")
  149.  
  150.     if vpitch < 1 then vpitch = 1
  151.  
  152.     hspace = hpitch - lwid
  153.     lmarg = (cwidth - (cols * hpitch - hpitch + lwid)) / 2
  154.     tmarg = (vpitch - lheight) / 2
  155.  
  156.     newpage = pdm_CreatePage(pdm_CurrentPage() + 1,1,)
  157.     call pdm_SetPageSize(newpage, cwidth, vpitch)
  158.     call pdm_GotoPage(newpage)
  159.  
  160.     if group = 1 then
  161.     do
  162.         call ScaleToPage(lwid, lheight, pdm_CurrentPage())
  163.         call pdm_GroupObj()
  164.     end
  165.     else
  166.     do
  167.         obj = pdm_DrawRectangle(lmarg, tmarg, lmarg + lwid, tmarg + lheight)
  168.         call pdm_SelectObj(obj)
  169.     end
  170.  
  171.     call TileSelection.pdrx(lmarg,tmarg,1, cols, hpitch, vpitch)
  172.  
  173.     call pdm_SetDMEject(0)
  174.     call pdm_SetDMPageSize(cwidth, vpitch)
  175.     cwidth = pdm_ConvertUnits(1, units, cwidth)
  176.     vpitch = pdm_ConvertUnits(1, units, vpitch)
  177.  
  178.     if units = 1 then unit = "inches"
  179.     else if units = 2 then unit = "CM"
  180.     else if units = 3 then unit = "Picas"
  181.  
  182.     message = "Done. The Dot Matrix Page Eject has been turned off and the output page size has been set to "cwidth" "unit" x "vpitch" "unit
  183.  
  184. end
  185.  
  186. npages = npages - 1
  187. cpage = pdm_CurrentPage()
  188.  
  189. do npages
  190.  
  191.     call pdm_CopyPage(cpage, cpage + 1, 1)
  192.     cpage = cpage + 1
  193.  
  194. end
  195.  
  196. exit_msg(message)
  197.  
  198. exit_msg: procedure expose units
  199. do
  200.     parse arg message
  201.  
  202.     if message ~= '' then call pdm_Inform(1,message,)
  203.     call pdm_ClearStatus()
  204.     call pdm_SetUnits(units)
  205.     call pdm_AutoUpdate(1)
  206.     exit
  207. end
  208.  
  209. ScaleToPage: procedure
  210. do
  211.     parse arg width, height, page
  212.  
  213.     objsize = pdm_GetObjVisSize()
  214.     owidth     = word(objsize, 1)
  215.     oheight  = word(objsize, 2)
  216.  
  217.     objpos = pdm_GetObjPosn()
  218.     left = word(objpos, 1)
  219.     top = word(objpos, 2)
  220.  
  221.     wscale = width / owidth
  222.     hscale = height / oheight
  223.  
  224. /* Want to keep aspect ratio, so use smaller scale factor for both */
  225.     if wscale > hscale then wscale = hscale
  226.     else hscale = wscale
  227.  
  228.     call pdm_ScaleObj(, wscale, hscale)
  229.     call pdm_SetObjPage(,page)
  230.  
  231.     return
  232. end
  233.